home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 February / EnigmA AMIGA RUN 04 (1996)(G.R. Edizioni)(IT)[!][issue 1996-02][Skylink CD III].iso / earcd / comm2 / tafltggr.lha / rexx / FExclude.trans < prev    next >
Text File  |  1995-08-06  |  6KB  |  290 lines
  1. /* Script to Exclude FileAreas for use within TransAmiga */
  2. options results
  3. signal on error
  4. signal on ioerr
  5. signal on halt
  6. signal on break_c
  7. signal on syntax
  8. signal on failure
  9.  
  10. if ~show('L', "rexxsupport.library") then
  11.   if ~addlib("rexxsupport.library", 0, -30, 0) then do
  12.     say "Couldn't access support.library !"
  13.     exit 20
  14.   end
  15.  
  16.  
  17. SystemData:
  18. date     = '30th of July 1995'
  19. author   = 'Juergen A.Lamers'
  20. fileconfig  = 'BBS:Configs/file.cfg'
  21. setupdir ='BBS:System/Setups/'
  22. count = 0
  23. fcount = 0
  24. scrlen = 23
  25.  
  26. parse arg what
  27.  
  28. userinfo 'a' ; name = result
  29. userinfo 'o' ; access = result
  30. userinfo 'v' ; scrlen = result
  31. if scrlen=0 then scrlen=24
  32. name=translate(name,'_',' ')
  33. if length(name)>20 then
  34.   name=left(name,1,20)
  35. name=setupdir||name'.excl'
  36. UserExcl= GetExclude()
  37.  
  38. call setansi
  39. print 'Get information'blink'...'
  40. call readfconfig
  41. cls
  42. numareas=strip(numareas)
  43.  
  44. do a = 1 to numareas
  45.   wht = ((a % 31)*4)+1
  46.   pos = (a // 31)
  47.   if bittst(substr(UserExcl,wht,4),pos) then
  48.     libraryname.a = upper(libraryname.a)
  49.  
  50.   if AreaAccess.a<=access then do
  51.     transmit f4||' -'||BRIGHT||f7||a||NOANSI||f4'-'f7 libraryname.a
  52.     checkabort ; ab = result
  53.     if ab=1 then call break_c
  54.     count = count + 1
  55.   end
  56.   if count>=scrlen-2 then do
  57.     getchar f3||'Q'noansi' - Quit  '||f3'N'noansi' - Next  'f3'E'noansi' - Exclude  'f3'I'noansi' - Include'||f7||b0' ' ; cmd = UPPER(result)
  58.     if cmd='N' then do
  59.       count = 0
  60.     end
  61.     if cmd='Q' then do
  62.       newline
  63.       call PutExclude;
  64.       exit
  65.     end
  66.     if cmd='E' then do
  67.       count = 0
  68.       call ExclFileA('1')
  69.     end
  70.     if cmd='I' then do
  71.       count = 0
  72.       call ExclFileA('0')
  73.     end
  74.     else do
  75.       count = 0
  76.       newline
  77.     end
  78.     cls
  79.   end
  80. end
  81.  
  82. if count>0 then do
  83.   getchar f3'E'noansi' - Exclude  'f3'I'noansi' - Include'||f7||b0' ' ; cmd = UPPER(result)
  84.   if cmd='E' then do
  85.     call ExclFileA('1')
  86.   end
  87.   if cmd='I' then do
  88.     call ExclFileA('0')
  89.   end
  90. end
  91.  
  92. scriptexit:
  93. call PutExclude;
  94.  
  95. shutdown ; exit 0
  96.  
  97.  
  98. readfconfig:
  99. /*
  100.     this routine reads BBS:Configs/file.cfg to find file area
  101.     names and paths for directorys to process. It also determines
  102.     the number of areas.
  103. */
  104. config = exists(fileconfig)
  105. if config ~= 0 then do
  106.   config = 1
  107.   call open('infile',fileconfig,'R')
  108.   do a = 1 to 3
  109.     dud = readln('infile')
  110.   end
  111.   numareas = readln('infile')
  112.   do b = 1 to numareas
  113.     libraryname.b = readln('infile')
  114.     path.b = readln('infile')
  115.     do c = 1 to 2
  116.       dud = readln('infile')
  117.     end
  118.     AreaAccess.b = readln('infile')
  119.     do c = 1 to 3
  120.       dud = readln('infile')
  121.     end
  122.   end
  123. end
  124. call close('infile')
  125.  
  126. return
  127.  
  128.  
  129. setansi:
  130. /*  Use to set ansi on and use colors */
  131.  userinfo 'x' ; ansiflag = result
  132.  if ansiflag = 'ON' then do
  133.   ESC     = '1B'X
  134.   ClrLine = ESC||'[K'
  135.   Blink   = ESC||'[5m'
  136.   BRIGHT  = ESC||'[1m'
  137.   NOANSI  = ESC||'[0m'
  138.   ITALICS = ESC||'[3m'
  139.   ULINE   = ESC||'[4m'
  140.   INVERSE = ESC||'[7m'
  141.   UP      = ESC||'[A'
  142.   DOWN    = ESC||'[B'
  143.   RIGHT   = ESC||'[C'
  144.   LEFT    = ESC||'[D'
  145.   f0 = ESC||'[30m' ;b0 = ESC||'[40m'  /* Black  */
  146.   f1 = ESC||'[31m' ;b1 = ESC||'[41m'  /* Red    */
  147.   f2 = ESC||'[32m' ;b2 = ESC||'[42m'  /* Green  */
  148.   f3 = ESC||'[33m' ;b3 = ESC||'[43m'  /* Yellow */
  149.   f4 = ESC||'[34m' ;b4 = ESC||'[44m'  /* Blue   */
  150.   f5 = ESC||'[35m' ;b5 = ESC||'[45m'  /* Purple */
  151.   f6 = ESC||'[36m' ;b6 = ESC||'[46m'  /* Cyan   */
  152.   f7 = ESC||'[37m' ;b7 = ESC||'[47m'  /* White  */
  153.   end
  154.  else do
  155.   ESC     = '1B'X
  156.   Blink=''
  157.   ClrLine = ''
  158.   BRIGHT  = ''
  159.   NOANSI  = ''
  160.   ITALICS = ''
  161.   ULINE   = ''
  162.   INVERSE = ''
  163.   UP      = ESC||'[A'
  164.   DOWN    = ESC||'[B'
  165.   RIGHT   = ESC||'[C'
  166.   LEFT    = ESC||'[D'
  167.   f0 = '' ; b0 = ''
  168.   f1 = '' ; b1 = ''
  169.   f2 = '' ; b2 = ''
  170.   f3 = '' ; b3 = ''
  171.   f4 = '' ; b4 = ''
  172.   f5 = '' ; b5 = ''
  173.   f6 = '' ; b6 = ''
  174.   f7 = '' ; b7 = ''
  175.   end
  176.  return
  177.  
  178.  
  179. cleanup:
  180.         sysoplog name||' Exiting '
  181. return 0
  182.  
  183. /*  Error handling */
  184. break_c:
  185. error:
  186.     sysoplog name||' aborted FExclude.trans'
  187.     call cleanup()
  188.     exit 10
  189.  
  190. syntax:
  191.         call template_oops "Syntax(RC=" || RC || ")" sigl
  192. failure:
  193.         call template_oops "Failure(RC=" || RC || ")" sigl
  194. ioerr:
  195.         call template_oops "IOErr" sigl
  196. halt:
  197.         call template_oops "Halt" sigl
  198.  
  199. template_oops:
  200.         parse arg what badline
  201.         Sysoplog 'ERR:'||what||"Line:"||badline
  202.         sysopLog 'ERR:'||strip(sourceline(badline))
  203.         call cleanup()
  204.         exit(40)
  205.  
  206. ExclFileA:
  207. parse arg what
  208.  
  209. newline
  210. ExclFileA2:
  211. query up||ClrLine||f3||'Q'noansi' - Quit  'f3'B'noansi' - Back  Welche Areas? 'f4'['bright||f7'1'noansi'..'bright||f7||numareas||noansi||f4'] 'noansi ; choices = result
  212. choices=upper(compress(choices))
  213. if choices='' then return ''
  214. if choices='B' then return ''
  215. if choices='Q' then signal scriptexit
  216. pp = ''
  217. do while length(choices)~=0
  218.   send=1
  219.   kpos=pos(',',choices)
  220.   leni=length(choices)+1
  221.   if kpos=0 then kpos=leni
  222.   bpos=pos('-',choices)
  223.   if bpos=0 then bpos=leni
  224.   if kpos>0 & kpos<bpos then do
  225.     num=''
  226.     parse var choices  num ',' choices
  227.     if num~='' & num>0 & num<=numareas then do
  228.       wht = ((num % 31)*4)+1
  229.       pos = (num // 31)
  230.       str=substr(UserExcl,wht,4)
  231.       if what then
  232.         str=bitset(str,pos)
  233.       else
  234.         str=bitclr(str,pos)
  235.       UserExcl=overlay(str,UserExcl,wht,4)
  236.     end
  237.   end
  238.   if bpos>0 & bpos<kpos then do
  239.     von=''
  240.     bis=''
  241.     parse var choices von '-' bis ',' choices
  242.     if bis='' then bis=numareas
  243.     if von='' then von=1
  244.     do mm = von to bis
  245.       if mm>0 & mm<=numareas then do
  246.         wht = ((mm % 31)*4)+1
  247.         pos = (mm // 31)
  248.         str=substr(UserExcl,wht,4)
  249.         if what then
  250.           str=bitset(str,pos)
  251.         else
  252.           str=bitclr(str,pos)
  253.         UserExcl=overlay(str,UserExcl,wht,4)
  254.       end
  255.     end
  256.   end
  257.   if (Bpos=leni) & (kpos=leni) then do
  258.     if choices~='' & choices>0 & choices<=numareas then do
  259.       wht = ((choices % 31)*4)+1
  260.       pos = (choices // 31)
  261.       str=substr(UserExcl,wht,4)
  262.       if what then
  263.         str=bitset(str,pos)
  264.       else
  265.         str=bitclr(str,pos)
  266.       UserExcl=overlay(str,UserExcl,wht,4)
  267.     end
  268.     choices = ''
  269.   end
  270. end
  271. signal ExclFileA2
  272. return pp
  273.  
  274. GetExclude:
  275.  
  276. if ~open(ifile,name,'R') then
  277.   return ','
  278. dummy = readch(ifile,4004)
  279. call close(ifile);
  280. return dummy
  281.  
  282. PutExclude:
  283.  
  284. if ~open(ifile,name,'W') then
  285.   return ','
  286. call writech(ifile,UserExcl)
  287. call close(ifile);
  288.  
  289.  
  290.